home *** CD-ROM | disk | FTP | other *** search
/ MacFormat España 13 / MacFormat n. 13 (Spain) / Macformat 13.bin / Shareware Internet / Desarrolladores / ICAppSourceKit1.2 / ICDialogs.p < prev    next >
Encoding:
Text File  |  1995-11-07  |  17.3 KB  |  686 lines
  1. unit ICDialogs;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Quickdraw, Dialogs;
  7.         
  8.     const
  9.         i_ok = 1;
  10.         i_cancel = 2;
  11.         i_discard = 3;
  12.  
  13.     type
  14.         SavedWindowInfo = record
  15.                 oldport: GrafPtr;
  16.                 thisport: GrafPtr;
  17.                 font: integer;
  18.                 size: integer;
  19.                 face: Style;
  20.             end;
  21.  
  22.     procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style; var saved: SavedWindowInfo);
  23.     procedure ExitWindow (saved: SavedWindowInfo);
  24.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  25.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  26.     function GetItemTextF (dlg: dialogPtr; item: integer): str255;
  27.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  28.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  29.     procedure FlashItem (dlg: dialogPtr; item: integer);
  30.     procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
  31.     procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
  32.     procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
  33.     procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
  34.     function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
  35.     function GetDItemHandle (dp: dialogPtr; item: integer): handle;
  36.     procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
  37.     function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
  38.     procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
  39.     function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
  40.     procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
  41.     function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
  42.     procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
  43.     procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
  44.     function GetDCtlValue (dp: dialogPtr; item: integer): integer;
  45.     procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
  46.     procedure DrawDItem (dp: dialogPtr; item: integer);
  47.     function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
  48.     procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
  49.     procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
  50.     procedure GetDAFont (var font: integer);
  51.     procedure SetWindowTitle (window: windowPtr; title: str255);
  52.     function SelectedTextItem (dlg: DialogPtr): integer;
  53.     procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
  54.     procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
  55. { s= "font:size:style:just:text" }
  56.     procedure ShiftTab (dlg: DialogPtr);
  57.     function CountDItems (dlg: DialogPtr): integer;
  58.     function OKModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  59.     function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  60.     function CancelDiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  61.     procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
  62.     function TrackItems(window:WindowPtr; i1,i2,i3:integer):boolean;
  63.  
  64. implementation
  65.  
  66.     uses
  67.         TextUtils, Fonts, ICMiscSubs;
  68.         
  69.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  70.         var
  71.             it: integer;
  72.             ih: handle;
  73.             box: rect;
  74.             oldtext: str255;
  75.     begin
  76.         GetDialogItem(dlg, item, it, ih, box);
  77.         GetDialogItemText(ih, oldtext);
  78.         if oldtext <> text then
  79.             SetDialogItemText(ih, text);
  80.     end;
  81.  
  82.     procedure GetItemText (dlg: dialogPtr; item: integer; var text: str255);
  83.         var
  84.             it: integer;
  85.             ih: handle;
  86.             box: rect;
  87.     begin
  88.         GetDialogItem(dlg, item, it, ih, box);
  89.         GetDialogItemText(ih, text);
  90.     end;
  91.  
  92.     function GetItemTextF (dlg: dialogPtr; item: integer): str255;
  93.         var
  94.             text: str255;
  95.     begin
  96.         GetItemText(dlg, item, text);
  97.         GetItemTextF := text;
  98.     end;
  99.  
  100.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  101.         var
  102.             kind: integer;
  103.             h: handle;
  104.             r: rect;
  105.     begin
  106.         item := item; { Unused }
  107.         SetPort(dp);
  108.         GetDialogItem(dp, 1, kind, h, r);
  109.         PenSize(3, 3);
  110.         InsetRect(r, -4, -4);
  111.         if controlHandle(h)^^.contrlHilite = 255 then
  112.             PenPat(qd.gray);
  113.         FrameRoundRect(r, 16, 16);
  114.         if controlHandle(h)^^.contrlHilite = 255 then
  115.             PenPat(qd.black);
  116.         PenNormal;
  117.     end;
  118.  
  119.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  120.         var
  121.             kind: integer;
  122.             h: handle;
  123.             r: rect;
  124.     begin
  125.         if def_item <> 1 then
  126.             DebugStr('SetUpDefaultOutline:Cant handle anything except 1 yet');
  127.         GetDialogItem(dp, user_item, kind, h, r);
  128.         InsetRect(r, -10, -10);
  129.         SetDialogItem(dp, user_item, userItem, handle(@OutlineDefault1), r);
  130.     end;
  131.  
  132.     procedure FlashItem (dlg: dialogPtr; item: integer);
  133.         var
  134.             kind: integer;
  135.             h: handle;
  136.             r: rect;
  137.             f: longInt;
  138.     begin
  139.         GetDialogItem(dlg, item, kind, h, r);
  140.         HiliteControl(controlHandle(h), kControlButtonPart);
  141.         Delay(2, f);
  142.         HiliteControl(controlHandle(h), 0);
  143.     end;
  144.  
  145.     procedure SetDItemRect (dp: dialogPtr; item: integer; rr: rect);
  146.         var
  147.             kind: integer;
  148.             h: handle;
  149.             r: rect;
  150.     begin
  151.         GetDialogItem(dp, item, kind, h, r);
  152.         SetDialogItem(dp, item, kind, h, rr);
  153.     end;
  154.  
  155.     procedure GetDItemRect (dp: dialogPtr; item: integer; var rr: rect);
  156.         var
  157.             kind: integer;
  158.             h: handle;
  159.     begin
  160.         GetDialogItem(dp, item, kind, h, rr);
  161.     end;
  162.  
  163.     procedure SetDItemKind (dp: dialogPtr; item: integer; k: integer);
  164.         var
  165.             kk: integer;
  166.             h: handle;
  167.             r: rect;
  168.     begin
  169.         GetDialogItem(dp, item, kk, h, r);
  170.         SetDialogItem(dp, item, k, h, r);
  171.     end;
  172.  
  173.     procedure GetDItemKind (dp: dialogPtr; item: integer; var k: integer);
  174.         var
  175.             r: rect;
  176.             h: handle;
  177.     begin
  178.         GetDialogItem(dp, item, k, h, r);
  179.     end;
  180.  
  181.     function GetDControlHandle (dp: dialogPtr; item: integer): controlHandle;
  182.     begin
  183.         GetDControlHandle := ControlHandle(GetDItemHandle(dp, item));
  184.     end;
  185.  
  186.     function GetDItemhandle (dp: dialogPtr; item: integer): handle;
  187.         var
  188.             kind: integer;
  189.             h: handle;
  190.             r: rect;
  191.     begin
  192.         GetDialogItem(dp, item, kind, h, r);
  193.         GetDItemhandle := h;
  194.     end;
  195.  
  196.     procedure SetDItemHandle (dp: dialogPtr; item: integer; h: univ handle);
  197.         var
  198.             kind: integer;
  199.             hh: handle;
  200.             r: rect;
  201.     begin
  202.         GetDialogItem(dp, item, kind, hh, r);
  203.         SetDialogItem(dp, item, kind, h, r);
  204.     end;
  205.  
  206.     function GetDCtlEnable (dlg: dialogPtr; item: integer): boolean;
  207.         var
  208.             k: integer;
  209.             h: handle;
  210.             r: rect;
  211.     begin
  212.         GetDialogItem(dlg, item, k, h, r);
  213.         GetDCtlEnable := controlHandle(h)^^.contrlHilite <> 255;
  214.     end;
  215.  
  216.     procedure SetDCtlEnable (dp: dialogPtr; item: integer; on: boolean);
  217.         var
  218.             ch: ControlHandle;
  219.             hilite: integer;
  220.     begin
  221.         ch := GetDControlHandle(dp, item);
  222.         hilite := 255 * ord(not on);
  223.         if ch^^.contrlHilite <> hilite then begin
  224.             HiliteControl(ch, hilite);
  225.         end;
  226.     end;
  227.  
  228.     function GetDCtlTitle (dp: dialogPtr; item: integer): str255;
  229.         var
  230.             s: str255;
  231.     begin
  232.         GetControlTitle(GetDControlHandle(dp, item), s);
  233.         GetDCtlTitle := s;
  234.     end;
  235.  
  236.     procedure SetDCtlTitle (dp: dialogPtr; item: integer; s: str255);
  237.         var
  238.             ch: ControlHandle;
  239.             old: str255;
  240.     begin
  241.         ch := GetDControlHandle(dp, item);
  242.         GetControlTitle(ch, old);
  243.         if old <> s then begin
  244.             SetControlTitle(ch, s);
  245.         end;
  246.     end;
  247.  
  248.     function GetDCtlBoolean (dp: dialogPtr; item: integer): boolean;
  249.     begin
  250.         GetDCtlBoolean := GetControlValue(GetDControlHandle(dp, item)) <> 0;
  251.     end;
  252.  
  253.     procedure SetDCtlBoolean (dp: dialogPtr; item: integer; value: boolean);
  254.     begin
  255.         SetControlValue(GetDControlHandle(dp, item), ord(value));
  256.     end;
  257.  
  258.     procedure ToggleDCtlBoolean (dp: dialogPtr; item: integer);
  259.     begin
  260.         SetDCtlBoolean(dp, item, not GetDCtlBoolean(dp, item));
  261.     end;
  262.  
  263.     function GetDCtlValue (dp: dialogPtr; item: integer): integer;
  264.     begin
  265.         GetDCtlValue := GetControlValue(GetDControlHandle(dp, item));
  266.     end;
  267.  
  268.     procedure SetDCtlValue (dp: dialogPtr; item: integer; value: integer);
  269.     begin
  270.         SetControlValue(GetDControlHandle(dp, item), value);
  271.     end;
  272.  
  273.     procedure DrawDItem (dp: dialogPtr; item: integer);
  274.     begin
  275.         Draw1Control(GetDControlHandle(dp, item));
  276.     end;
  277.  
  278.     function GetPopupMHandle (dlg: dialogPtr; item: integer): menuHandle;
  279.         type
  280.             MenuHandlePtr = ^MenuHandle;
  281.             MenuHandleHandle = ^MenuHandlePtr;
  282.     begin
  283.         GetPopupMHandle := MenuHandleHandle(ControlHandle(GetDItemHandle(dlg, item))^^.contrlData)^^;
  284.     end;
  285.  
  286.     procedure SetPopUpMenuOnMouseDown (dlg: dialogPtr; item: integer; text: str255);
  287.         var
  288.             mh: MenuHandle;
  289.             i, index: integer;
  290.             s: str255;
  291.     begin
  292.         mh := GetPopupMHandle(dlg, item);
  293.         if text = '' then begin
  294.             GetMenuItemText(mh, 1, text);
  295.         end;
  296.         GetMenuItemText(mh, 2, s);
  297.         if s = '-' then begin
  298.             DeleteMenuItem(mh, 2);
  299.             DeleteMenuItem(mh, 1);
  300.         end;
  301.         index := 0;
  302.         for i := 1 to CountMItems(mh) do begin
  303.             GetMenuItemText(mh, i, s);
  304.             if (IUEqualString(s, text) = 0) then begin
  305.                 index := i;
  306.                 leave;
  307.             end;
  308.         end;
  309.         if index = 0 then begin
  310.             InsertMenuItem(mh, '(-;fred', 0);
  311.             SetMenuItemText(mh, 1, text);
  312.             index := 1;
  313.         end;
  314.         SetDCtlValue(dlg, item, index);
  315.     end;
  316.  
  317.     procedure GetPopUpItemText (dlg: dialogPtr; item: integer; var text: str255);
  318.         var
  319.             mh: MenuHandle;
  320.     begin
  321.         mh := GetPopupMHandle(dlg, item);
  322.         GetMenuItemText(GetPopupMHandle(dlg, item), GetDCtlValue(dlg, item), text);
  323.     end;
  324.  
  325.     procedure GetDAFont (var font: integer);
  326.         type
  327.             intPtr = ^integer;
  328.         const
  329.             DlgFont = $AFA;
  330.     begin
  331.         font := intPtr(DlgFont)^;
  332.     end;
  333.  
  334.     procedure SetWindowTitle (window: windowPtr; title: str255);
  335.         var
  336.             s: str255;
  337.     begin
  338.         GetWTitle(window, s);
  339.         if s <> title then
  340.             SetWTitle(window, title);
  341.     end;
  342.  
  343.     function SelectedTextItem (dlg: DialogPtr): integer;
  344.     begin
  345.         SelectedTextItem := DialogPeek(dlg)^.editField + 1;
  346.     end;
  347.  
  348.     function CountDItems (dlg: DialogPtr): integer;
  349.         type
  350.             IntegerPtr = ^Integer;
  351.             IntegerHandle = ^IntegerPtr;
  352.     begin
  353.         CountDItems := IntegerHandle(DialogPeek(dlg)^.items)^^ + 1;
  354.     end;
  355.  
  356.     procedure ShiftTab (dlg: DialogPtr);
  357.         var
  358.             orgitem, i, count: integer;
  359.             k: integer;
  360.     begin
  361.         orgitem := SelectedTextItem(dlg);
  362.         count := CountDItems(dlg);
  363.         if (orgitem > 0) & (count > 1) then begin
  364.             i := orgitem;
  365.             repeat
  366.                 i := i - 1;
  367.                 if i = 0 then begin
  368.                     i := count;
  369.                 end;
  370.                 GetDItemKind(dlg, i, k);
  371.             until (i = orgitem) | (k = editText);
  372.         end;
  373.         GetDItemKind(dlg, i, k);
  374.         if k = editText then begin
  375.             SelectDialogItemText(dlg, i, 0, 255);
  376.         end;
  377.     end;
  378.  
  379.     procedure DrawTheFriggingGrowIcon (window: windowPtr; bounds: rect);
  380.         var
  381.             clip: RgnHandle;
  382.     begin
  383.         SetPort(window);
  384.         PenNormal;
  385.         clip := NewRgn;
  386.         GetClip(clip);
  387.         ClipRect(bounds);
  388.         DrawGrowIcon(window);
  389.         SetClip(clip);
  390.         DisposeRgn(clip);
  391.     end;
  392.  
  393.     function DoButtonKey (dlg: DialogPtr; item: integer; var er: EventRecord; var result_item: integer): boolean;
  394.     begin
  395.         if GetDCtlEnable(dlg, item) then begin
  396.             result_item := item;
  397.             FlashItem(dlg, item);
  398.             DoButtonKey := true;
  399.         end else begin
  400.             SysBeep(10);
  401.             er.what := nullEvent;
  402.             DoButtonKey := false;
  403.         end;
  404.     end;
  405.  
  406.     function OKModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  407.         var
  408.             ch: integer;
  409.     begin
  410.         OKModalFilter := false;
  411.         if (er.what = keyDown) or (er.what = autoKey) then begin
  412.             ch := BAND(er.message, $FF);
  413.             if (ch = 13) or (ch = 3) then begin
  414.                 OKModalFilter := DoButtonKey(dlg, i_ok, er, item);
  415.             end;
  416.         end;
  417.     end;
  418.  
  419.     function CancelModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  420.         var
  421.             ch: integer;
  422.     begin
  423.         CancelModalFilter := false;
  424.         if (er.what = keyDown) or (er.what = autoKey) then begin
  425.             ch := BAND(er.message, $FF);
  426.             if (ch = 13) or (ch = 3) then begin
  427.                 CancelModalFilter := DoButtonKey(dlg, i_ok, er, item);
  428.             end else if ((ch = ord('.')) and (BAND(er.modifiers, cmdKey) <> 0)) or (ch = 27) then begin
  429.                 CancelModalFilter := DoButtonKey(dlg, i_cancel, er, item);
  430.             end;
  431.         end;
  432.     end;
  433.  
  434.     function CancelDiscardModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
  435.         var
  436.             ch: integer;
  437.     begin
  438.         CancelDiscardModalFilter := false;
  439.         if CancelModalFilter(dlg, er, item) then begin
  440.             CancelDiscardModalFilter := true;
  441.         end else if (er.what = keyDown) or (er.what = autoKey) then begin
  442.             ch := BAND(er.message, $FF);
  443.             if (ch = ord('d')) and (BAND(er.modifiers, cmdKey) <> 0) then begin
  444.                 CancelDiscardModalFilter := DoButtonKey(dlg, i_discard, er, item);
  445.             end;
  446.         end;
  447.     end;
  448.  
  449.     procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style; var saved: SavedWindowInfo);
  450.     begin
  451.         GetPort(saved.oldport);
  452.         SetPort(window);
  453.         saved.thisport := window;
  454.         saved.font := window^.txFont;
  455.         saved.size := window^.txSize;
  456.         saved.face := window^.txFace;
  457.         TextFont(font);
  458.         TextSize(size);
  459.         TextFace(face);
  460.     end;
  461.  
  462.     procedure ExitWindow (saved: SavedWindowInfo);
  463.     begin
  464.         SetPort(saved.thisport);
  465.         TextFont(saved.font);
  466.         TextSize(saved.size);
  467.         TextFace(saved.face);
  468.         SetPort(saved.oldport);
  469.     end;
  470.  
  471.     procedure DrawGrayRect (dlg: DialogPtr; item: integer; title: str255);
  472.         const
  473.             left_indent = 20;
  474.             gap = 2;
  475.         var
  476.             r, er: rect;
  477.             fi: FontInfo;
  478.             sw: integer;
  479.     begin
  480.         GetDItemRect(dlg, item, r);
  481.         GetFontInfo(fi);
  482.         MoveTo(r.left + left_indent, r.top + fi.ascent);
  483.         sw := StringWidth(title);
  484.         er.top := r.top;
  485.         er.bottom := er.top + fi.ascent + fi.descent;
  486.         er.left := r.left + left_indent;
  487.         er.right := er.left + sw;
  488.         EraseRect(er);
  489.         DrawString(title);
  490.         PenPat(qd.gray);
  491.         r.top := r.top + (fi.ascent) div 2;
  492.         MoveTo(er.left - gap, r.top);
  493.         LineTo(r.left, r.top);
  494.         LineTo(r.left, r.bottom);
  495.         LineTo(r.right, r.bottom);
  496.         LineTo(r.right, r.top);
  497.         LineTo(er.right + gap, r.top);
  498.         PenNormal;
  499.     end;
  500.  
  501.     function Split (sub, s: str255; var s1, s2: str255): boolean;
  502.         var
  503.             p: integer;
  504.     begin
  505.         p := TPPos(sub, s);
  506.         if p > 0 then begin
  507.             s1 := TPCopy(s, 1, p - 1);
  508.             s2 := TPCopy(s, p + length(sub), 255);
  509.         end;
  510.         Split := p > 0;
  511.     end;
  512.     
  513.     procedure DisplayStyledString (dlg: dialogPtr; item: integer; s: str255);
  514.         function StrToNum(var s:Str255):integer;
  515.             var
  516.                 n : longInt;
  517.         begin
  518.             StringToNum(s,n);
  519.             StrToNum:=n;
  520.         end;
  521.         var
  522.             box: rect;
  523.             just: integer;
  524.             this: str255;
  525.             font, size, i, j, def_font, def_size: integer;
  526.             st: Style;
  527.             fi: FontInfo;
  528.             fixsize: boolean;
  529.             oldfont, oldsize: integer;
  530.             oldface: Style;
  531.             hot: Boolean; { parse for <> and blue-underline them }
  532.             teh:TEHandle;
  533.             tsr:TextStyle;
  534.     begin
  535.         SetPort(dlg);
  536.         oldfont := dlg^.txFont;
  537.         oldsize := dlg^.txSize;
  538.         oldface := dlg^.txFace;
  539.         def_font := geneva;
  540.         def_size := 9;
  541.         GetDItemRect(dlg, item, box);
  542.         if Split(':', s, this, s) then begin
  543.             hot := false;
  544.             fixsize := false;
  545.             if this = '' then begin
  546.                 font := def_font;
  547.             end else begin
  548.                 GetFNum(this, font);
  549.                 if font = 0 then begin
  550.                     fixsize := true;
  551.                     font := def_font;
  552.                 end;
  553.             end;
  554.             if Split(':', s, this, s) then begin
  555.                 if this = '' then begin
  556.                     size := def_size;
  557.                 end else begin
  558.                     size := StrToNum(this);
  559.                 end;
  560.                 if Split(':', s, this, s) then begin
  561.                     st := [];
  562.                     for i := 1 to length(this) do begin
  563.                         case this[i] of
  564.                             '0'..'7':begin
  565.                                 st := st + [StyleItem(ord(this[i]) - 48)];
  566.                             end;
  567.                             'H','h': begin
  568.                                 hot := true;
  569.                             end;
  570.                             otherwise begin
  571.                             end;
  572.                         end;
  573.                     end;
  574.                     if Split(':', s, this, s) then begin
  575.                         if this = '' then begin
  576.                             just := teJustLeft;
  577.                         end else begin
  578.                             just := StrToNum(this);
  579.                         end;
  580.                         TextFont(font);
  581.                         TextSize(size);
  582.                         TextFace(st);
  583.                         if fixsize then begin
  584.                             GetFontInfo(fi);
  585.                             while (fi.ascent + fi.descent > box.bottom - box.top) do begin
  586.                                 if size > 48 then begin
  587.                                     size := 48;
  588.                                 end else if size > 36 then begin
  589.                                     size := 36;
  590.                                 end else if size > 27 then begin
  591.                                     size := 27;
  592.                                 end else if size > 24 then begin
  593.                                     size := 24;
  594.                                 end else if size > 18 then begin
  595.                                     size := 18;
  596.                                 end else if size > 14 then begin
  597.                                     size := 14;
  598.                                 end else if size > 12 then begin
  599.                                     size := 12;
  600.                                 end else begin
  601.                                     size := 9;
  602.                                     TextSize(size);
  603.                                     leave;
  604.                                 end;
  605.                                 TextSize(size);
  606.                                 GetFontInfo(fi);
  607.                             end;
  608.                         end;
  609.                         if false then begin
  610.                             TETextBox(@s[1], length(s), box, just);
  611.                         end else begin
  612.                             teh := TEStyleNew(box,box);
  613.                             if teh<>nil then begin
  614.                                 TESetText(@s[1],length(s),teh);
  615.                                 TESetAlignment(just,teh);
  616.                                 if hot then begin
  617.                                     for i := 1 to length(s) do begin
  618.                                         if s[i] = '<' then begin
  619.                                             j := i + 1;
  620.                                             while (j <= length(s)) & (s[j] <> '>') do begin
  621.                                                 j := j + 1;
  622.                                             end;
  623.                                             TESetSelect(i,j-1,teh);
  624.                                             tsr.tsFace := st + [underline];
  625.                                             tsr.tsColor.red := 0;
  626.                                             tsr.tsColor.green := 0;
  627.                                             tsr.tsColor.blue := $FFFF;
  628.                                             TESetStyle(doFace + doColor,tsr,false,teh);
  629.                                         end;
  630.                                     end;
  631.                                 end;
  632.                                 TEUpdate(box,teh);
  633.                                 TEDispose(teh);
  634.                             end;
  635.                         end;
  636.                     end;
  637.                 end;
  638.             end;
  639.         end;
  640.         TextFont(oldfont);
  641.         TextSize(oldsize);
  642.         TextFace(oldface);
  643.     end;
  644.  
  645.     function TrackItems(window:WindowPtr; i1,i2,i3:integer):boolean;
  646.         var
  647.             rgn:RgnHandle;
  648.         procedure AddItem(i:integer);
  649.             var
  650.                 itemrect:Rect;
  651.                 tmp:RgnHandle;
  652.         begin
  653.             if i <> 0 then begin
  654.                 GetDitemRect(window,i,itemrect);
  655.                 tmp := NewRgn;
  656.                 RectRgn(tmp, itemrect);
  657.                 UnionRgn(rgn, tmp, rgn);
  658.                 DisposeRgn(tmp);
  659.             end;
  660.         end;
  661.         var
  662.             inside,newinside:boolean;
  663.             mouse:Point;
  664.     begin
  665.         SetPort(window);
  666.         rgn := NewRgn;
  667.         AddItem(i1);
  668.         AddItem(i2);
  669.         AddItem(i3);
  670.         InvertRgn(rgn);
  671.         inside:=true;
  672.         while StillDown do begin
  673.             GetMouse(mouse);
  674.             newinside := PtInRgn(mouse,rgn);
  675.             if newinside <> inside then begin
  676.                 InvertRgn(rgn);
  677.                 inside := newinside;
  678.             end;
  679.         end;
  680.         if inside then begin
  681.             InvertRgn(rgn);
  682.         end;
  683.         TrackItems := inside;
  684.     end;
  685.  
  686. end.